home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / GIMP 2.6.8 / gimp-2.6.8-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / font-map.scm < prev    next >
Text File  |  2009-12-15  |  6KB  |  169 lines
  1. ;; font-select
  2. ;; Spencer Kimball
  3.  
  4. (define (script-fu-font-map text
  5.                             use-name
  6.                             labels
  7.                             font-filter
  8.                             font-size
  9.                             border
  10.                             colors)
  11.  
  12.   (define (max-font-width text use-name list-cnt list font-size)
  13.     (let* ((count    0)
  14.            (width    0)
  15.            (maxwidth 0)
  16.            (font     "")
  17.            (extents  '()))
  18.       (while (< count list-cnt)
  19.         (set! font (car list))
  20.  
  21.         (if (= use-name TRUE)
  22.             (set! text font))
  23.         (set! extents (gimp-text-get-extents-fontname text
  24.                                                       font-size PIXELS
  25.                                                       font))
  26.         (set! width (car extents))
  27.         (if (> width maxwidth)
  28.             (set! maxwidth width))
  29.  
  30.         (set! list (cdr list))
  31.         (set! count (+ count 1))
  32.       )
  33.  
  34.       maxwidth
  35.     )
  36.   )
  37.  
  38.   (define (max-font-height text use-name list-cnt list font-size)
  39.     (let* ((count     0)
  40.            (height    0)
  41.            (maxheight 0)
  42.            (font      "")
  43.            (extents   '()))
  44.       (while (< count list-cnt)
  45.         (set! font (car list))
  46.  
  47.         (if (= use-name TRUE)
  48.             (set! text font)
  49.         )
  50.         (set! extents (gimp-text-get-extents-fontname text
  51.                                                       font-size PIXELS
  52.                                                       font))
  53.         (set! height (cadr extents))
  54.         (if (> height maxheight)
  55.             (set! maxheight height)
  56.         )
  57.  
  58.         (set! list (cdr list))
  59.         (set! count (+ count 1))
  60.       )
  61.  
  62.       maxheight
  63.     )
  64.   )
  65.  
  66.   (let* (
  67.         (font-data  (gimp-fonts-get-list font-filter))
  68.         (font-list  (cadr font-data))
  69.         (num-fonts  (car font-data))
  70.         (label-size (/ font-size 2))
  71.         (border     (+ border (* labels (/ label-size 2))))
  72.         (y          border)
  73.         (maxheight  (max-font-height text use-name num-fonts font-list font-size))
  74.         (maxwidth   (max-font-width  text use-name num-fonts font-list font-size))
  75.         (width      (+ maxwidth (* 2 border)))
  76.         (height     (+ (+ (* maxheight num-fonts) (* 2 border))
  77.                        (* labels (* label-size num-fonts))))
  78.         (img        (car (gimp-image-new width height (if (= colors 0)
  79.                                                           GRAY RGB))))
  80.         (drawable   (car (gimp-layer-new img width height (if (= colors 0)
  81.                                                               GRAY-IMAGE RGB-IMAGE)
  82.                                          "Background" 100 NORMAL-MODE)))
  83.         (count      0)
  84.         (font       "")
  85.         )
  86.  
  87.     (gimp-context-push)
  88.  
  89.     (gimp-image-undo-disable img)
  90.  
  91.     (if (= colors 0)
  92.         (begin
  93.           (gimp-context-set-background '(255 255 255))
  94.           (gimp-context-set-foreground '(0 0 0))))
  95.  
  96.     (gimp-image-add-layer img drawable 0)
  97.     (gimp-edit-clear drawable)
  98.  
  99.     (if (= labels TRUE)
  100.         (begin
  101.           (set! drawable (car (gimp-layer-new img width height
  102.                                               (if (= colors 0)
  103.                                                   GRAYA-IMAGE RGBA-IMAGE)
  104.                                               "Labels" 100 NORMAL-MODE)))
  105.           (gimp-image-add-layer img drawable -1)))
  106.           (gimp-edit-clear drawable)
  107.  
  108.     (while (< count num-fonts)
  109.       (set! font (car font-list))
  110.  
  111.       (if (= use-name TRUE)
  112.           (set! text font))
  113.  
  114.       (gimp-text-fontname img -1
  115.                           border
  116.                           y
  117.                           text
  118.                           0 TRUE font-size PIXELS
  119.                           font)
  120.  
  121.       (set! y (+ y maxheight))
  122.  
  123.       (if (= labels TRUE)
  124.           (begin
  125.             (gimp-floating-sel-anchor (car (gimp-text-fontname img drawable
  126.                                                                (- border
  127.                                                                   (/ label-size 2))
  128.                                                                (- y
  129.                                                                   (/ label-size 2))
  130.                                                                font
  131.                                                                0 TRUE
  132.                                                                label-size PIXELS
  133.                                                                "Sans")))
  134.           (set! y (+ y label-size))
  135.           )
  136.       )
  137.  
  138.       (set! font-list (cdr font-list))
  139.       (set! count (+ count 1))
  140.     )
  141.  
  142.     (gimp-image-set-active-layer img drawable)
  143.  
  144.     (gimp-image-undo-enable img)
  145.     (gimp-display-new img)
  146.  
  147.     (gimp-context-pop)
  148.   )
  149. )
  150.  
  151. (script-fu-register "script-fu-font-map"
  152.   _"Render _Font Map..."
  153.   _"Create an image filled with previews of fonts matching a fontname filter"
  154.   "Spencer Kimball"
  155.   "Spencer Kimball"
  156.   "1997"
  157.   ""
  158.   SF-STRING     _"_Text"                  "How quickly daft jumping zebras vex."
  159.   SF-TOGGLE     _"Use font _name as text" FALSE
  160.   SF-TOGGLE     _"_Labels"                TRUE
  161.   SF-STRING     _"_Filter (regexp)"       "Sans"
  162.   SF-ADJUSTMENT _"Font _size (pixels)"    '(32 2 1000 1 10 0 1)
  163.   SF-ADJUSTMENT _"_Border (pixels)"       '(10 0  200 1 10 0 1)
  164.   SF-OPTION     _"_Color scheme"          '(_"Black on white" _"Active colors")
  165. )
  166.  
  167. (script-fu-menu-register "script-fu-font-map"
  168.                          "<Fonts>")
  169.